lag <- dplyr::lag
select <- dplyr::select
filter <- dplyr::filter

wtd_rank <- function (x, weights = NULL, normwt = FALSE, na.rm = TRUE) {
  if (!length(weights)) 
    return(rank(x, na.last = if (na.rm) NA else TRUE))
  tab <- Hmisc::wtd.table(x, weights, normwt = normwt, na.rm = na.rm)
  freqs <- tab$sum.of.weights
  r <- cumsum(freqs) - 0.5 * (freqs - 1)
  approx(tab$x, r, xout = x, rule = 2)$y
}

wtd_prank <- function(x, w){
  wtd_rank(x, w, normwt = TRUE)/length(x[!is.na(x)])
}

Mode <- function(x, na.rm = TRUE) {
  if(na.rm) x <- x[complete.cases(x)]
  ux <- unique(x)
  ux[which.max(tabulate(match(x, ux)))]
}

Last <- function(x, na.rm = TRUE) {
  if(na.rm) x <- x[complete.cases(x)]
  x[length(x)]
}

`%notin%` <- Negate(`%in%`)

`%||%` <- function(a, b) if (!is.null(a)) a else b

cummax2 <- function(x) dplyr::na_if(cummax(tidyr::replace_na(x, -Inf)), -Inf)
cummin2 <- function(x) dplyr::na_if(cummin(tidyr::replace_na(x, Inf)), Inf)

library(tidyverse)
library(rlang)

p2star <- function(x){
  case_when(between(x, 0.05, 1) ~ "",
            between(x, 0.01, 0.05) ~ "*",
            between(x, 0.001, 0.01) ~ "**",
            between(x, 0, 0.001) ~ "***")
}

combine <- function(estimate, std.error, star, format, digits){
  paste0(formatC(estimate, format = format, digits = digits), star) %>%
    paste0(., " (", formatC(std.error, format = format, digits = digits), ")")
}

regtable <- function(..., format = "f", digits = 3){
  cl <- match.call()
  cl$format <- cl$digits <-  cl[[1]] <- NULL
  eval_tidy(expr(map(list2(!!!cl), broom::tidy))) %>%
    map(~ mutate(.x,
                 star = p2star(p.value),
                 out = combine(estimate, std.error, star,
                               format = format, digits = digits))) %>%
    map(~ dplyr::select(.x, term, out)) %>%
    reduce(full_join, by = "term") %>%
    mutate_all( ~ tidyr::replace_na(.x, "")) %>%
    set_names(c("term", map_chr(ensyms(...), as_string)))
}

median2 <- function(y, x) y[[order(x)[[ceiling(length(x)/2)]]]]

trim <- function(x, min = 0.01, max = 1) {
  x[x<min] <- min
  x[x>max] <- max
  x
}

scale2 <- function(x, w) (x - Hmisc::wtd.mean(x, w))/sqrt(Hmisc::wtd.var(x, w))

rowSums2 <- function(x) ifelse(rowSums(is.na(x), na.rm = TRUE) == ncol(x), NA, rowSums(x, na.rm = TRUE))
